perm filename S2.F4[LX,LCS] blob
sn#170756 filedate 1975-07-29 generic text, type T, neo UTF8
00100 SUBROUTINE READIT
00200 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
00300 1 LN,ITYP,TPALN(4),JED
00400 CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
00500 COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
00600 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700 1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800 1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900 DIMENSION IV(2000),LIST(78),JNP(80)
01000 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
01100 C 40 LIT CHARS + 30 PARAMS PER INST.
01200 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
01300 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01400 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01500 1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01600 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01700 1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01800 1 ZZ,CHN,YY
01900 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02000 1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
02100 1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
02200 1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
02300 C /C/=26
02400 EQUIVALENCE (VX1,VX(1)),(JNP,INP1,INP(1)),(IPP,ISCA(2))
02500 1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
02600 1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
02700 1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
02800 1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
02900 C *************** READS INPUT ***********************
03000 2308 IF(ITYP)GO TO 2127
03100 DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
03200 1,TEDIT/20H(' RETYPE LINE?'/ )/,IEN/'N'/,ITMPO/'TEMPO'/
03300 23081 TYPE TINST
03400 ACCEPT 77732,JNP
03500 77732 FORMAT(80A1)
03600 CC IF(JED)WRITE(21,77732)INP
03700 IF(JED)CALL COLTTY(JNP,21)
03800 JFM(4)='80A1)'
03900 C PUTS ON LPT AND TTY
04000 GO TO 1074
04100 CC 6/74 COLGATE2127 JREAD=1
04200 CC 6/74 COLGATE 4400 READ(1,77732,END=2337)JNP
04300 2127 IF(READER(JNP))CALL RUNIT
04400 C READS A LINE. IF END OF FILE, JUMPS.
04500 CC SEE END OF PG.6 IF(SOS)WRITE(JOUT,87732)INP
04600 CC 7/74 IF(SOS)CALL COLTTY(JNP,JOUT,3)
04700 CC 6/74 COLGATE GO TO(441,442,443,444,445,446)JREAD
04800
04900 441 JFM(4)='80A1)'
05000 IF(LN.EQ.0)GO TO 1074
05100 CC REREAD 2114,LN,JNP
05200 C**** READS ONLY FILES WITH LINE NUMBERS!
05300 JFM(1)=' (I,A'
05400 CALL FMT(JFM,JNP,MLX)
05500 REREAD JFM,LN,J,JNP
05600 GO TO 4127
05700 1074 JFM(1)=' (A'
05800 CALL FMT(JFM,JNP,MLX)
05900 REREAD JFM,J,JNP
06000 4127 IF(JED)GO TO 41271
06100 IF(K.EQ.'Y')GO TO 41271
06200 C K CHECK IS TO PASS AFTER RETYPING
06300 TYPE TEDIT
06400 ACCEPT 77732,K
06500 IF(K.EQ.'Y')GO TO 23081
06600 IF(K.EQ.IG)JED=-1
06700
06800
06900 41271 IF(J.EQ.IBLA)GO TO 2308
07000 MLX=1
07100 IZ=0
07200 JA=-1
07300 ISUB=4
07400 CALL CLEAN(INP,LEND)
07500 C CLEANS OUT = AND , AND FINDS LINE LENGTH.
07600 ALL=1.
07700 VX1=0
07800 VX2=0
07900 VX3=0
08000 LK=-1
08100 K=0
08200 IF(V(I-1).NE.-9900.-BY)GO TO 364
08300 BY=-1.
08400 I=I-1
08500 364 DO 361 JD=1,LEND
08600 N=INP(JD)
08700 IF(N.NE.'R')GO TO 361
08800 C LOOKS FOR 'RESTART'
08900 DO 3611 M=JD,LEND
09000 KL=INP(M)
09100 IF(KL.EQ.IBLA)GO TO 3631
09200 IF(KL.EQ.ISEMI)GO TO 3631
09300 CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
09400 3611 INP(M)=IBLA
09500 C CHANGES 'RESTART' TO BLANKS
09600 3631 DO 363 N=1,NINS
09700 IF(J.NE.INST(N))GO TO 363
09800 IQ(N)=-1
09900 C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
10000 GO TO 362
10100 363 CONTINUE
10200 361 IF(N.EQ.ISEMI)GO TO 6773
10300 6773 K=K+1
10400 IF(K.GT.NINS)GO TO 36
10500 IF(INST(K).NE.J)GO TO 6773
10600 IF(IQ(K).EQ.-1)GO TO 6773
10700 C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
10800 LK=K
10900 GO TO 1773
11000 36 IF(J.EQ.'RUN;')GO TO 197
11100 IF(J.NE.'RUN')GO TO 97
11200 197 CALL RUNIT
11300 97 IF(J.EQ.'INSER')GO TO 397
11400 IF(J.NE.'EDIT')GO TO 297
11500 397 ISUB=6
11600 297 IF(ISUB.GT.4)GO TO 1773
11700 IF(J.EQ.ITMPO)GO TO 1773
11800 IF(J.EQ.'CONDU')GO TO 1773
11900 IF(J.EQ.'PLAY')GO TO 1773
12000 IF(J.EQ.'SECTI')GO TO 1081
12100 C****************** ABOVE AND BELOW FOR 'SECTIONS'
12200 IF(J.EQ.'END')GO TO 1082
12300 IF(J.EQ.'END S')GO TO 1082
12400 IF(J.EQ.'FINIS')GO TO 1082
12500 362 LK=NINS+1
12600 IF(LK.GT.KZY)CALL ERR(LN)
12700 INST(LK)=J
12800 IZ=LK
12900 GO TO 1773
13000
13100 C*********** DOWN TO 8001 FOR 'SECTIONS'
13200 1083 V(I)=-99.
13300 KL=1
13400 GO TO 3083
13500 C READS 'PLAY SECT. N1,N2'
13600 1081 V(I)=-199.
13700 KL=4
13800 3083 DO 2081 K=KL,72
13900 C****** OR 80 ↑↑↑↑↑↑↑↑↑ ?????
14000 IF(INP(K).EQ.IBLA)GO TO 2081
14100 IV(I+1)=INP(K)
14200 I=I+2
14300 3081 BY=-1.
14400 GO TO 2308
14500 2081 CONTINUE
14600 C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
14700 C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
14800 C********* FEB 15,71
14900 1082 V(I)=-299.
15000 I=I+1
15100 GO TO 3081
15200 C MARKS END OF SECTION
15300 C************************
15400
15700 8001 FORMAT(A5,5F)
15800 107 FORMAT(I,A5,5F)
16000 4 IF(LK.LE.NINS)GO TO 8773
16100 IF(ALL.GT.0)GO TO 1004
16200 IF(IDALL.GT.0)GO TO 8773
16300 BG(LK)=VX1
16400 IDALL=LK
16500 GO TO 2004
16600 C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
16700 1004 BG(LK)=VX1
16800 IF(LK.EQ.IZ)VX1=0
16900 C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
17000 C CHECK EFFECT ON 'MOVE'!
17100 C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
17200 2004 NINS=LK
17300 IF(VX3.NE.0)VX2=10000.+VX3
17400 IF(VX2.EQ.0)VX2=-1
17500 DUR(LK)=VX2
17600 GO TO 900
17700 C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
17800 8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
17900 900 IF(VX1.NE.BY)GO TO 497
18000 IF(J.NE.'PLAY')GO TO 5773
18100 C*********** 'PLAY' IS FOR 'SECTIONS'
18200 497 BY=VX1
18300 C BY=CURRENT BG TIME.
18400 V(I)=-9900.-BY
18500 I=I+1
18600 IF(NWZ.NE.0)CALL BGSORT(BY)
18700 5773 IF(J.EQ.ITMPO)GO TO 1106
18800 IF(J.EQ.'CONDU')GO TO 3018
18900 IF(J.EQ.'PLAY')GO TO 1083
19000 C*********** ABOVE FOR 'SECTIONS'
19100
19200
19300 4773 NW=LPAR
19400 CZZZZZZZ MLX=ML
19500 ML=MLX
19600 IF(I.LT.1900)GO TO 774
19650 TYPE 107,I
19660 IF(I.GE.2000)TYPE 1774
19670 1774 FORMAT(/' ******* TOO MUCH INPUT DATA!! *******'/)
19700 774 ALL=1.
19800 DF=0
19900 ISUB=1
20000 IF(MLX.LT.LEND)GO TO 17732
20100 GO TO 7773
20200 CZZZZZZZZZZZZZZZZZZZZZZZZ
20300 1299 IF(MLX.LE.LEND)GO TO 1773
20400 CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ
20500 CC1299 IF(JZ.NE.0)GO TO 2773
20600
20700
20800 7773 IF(READER(JNP))CALL RUNIT
20900 C READS A LINE. IF END OF FILE, JUMPS.
21000 CC442 IF(LN.NE.0)REREAD 2114,LN,INP
21100 IF(INP1.EQ.IBLA)GO TO 7773
21200 IF(JED)GO TO 77733
21300 TYPE TEDIT
21400 ACCEPT 77732,K
21500 IF(K.NE.'Y')GO TO 442
21600 TYPE TPALN
21700 ACCEPT 77732,JNP
21800 442 IF(K.EQ.IG)JED=-1
21900 C DOESN'T WORK FOR EDITS AND INSERTS YET???
22000
22100
22200 77733 MLX=1
22300 C FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
22400 C 'LISTS' MUST END WITH ; IN NEW(7/74) VERSION.
22500 CALL CLEAN(INP,LEND)
22600 CC2773 CALL CLEAN(INP,LEND)
22700 1773 IF(IPRN.EQ.0)GO TO 17732
22800 L=I-1
22900 IF(QTS.GE.0)GO TO 597
23000 IF(V(I-1).EQ.999.)L=L-1
23100 597 IPRN=IPRN-1
23200 IF(PARENS.EQ.0)GO TO 17733
23300 PARENS=0
23400 LIST(LCNT+2)=L
23500 LCNT=LCNT+3
23600 IF(IPRN.EQ.0)GO TO 17732
23700 IPRN=0
23800 17733 LIST(MOT)=L
23900 MOT=0
24000 C FOR ERROR TRAP
24100
24200 CC17732 JZ=0
24300 17732 N=0
24400 17731 ML=MLX
24500
24600 C BIG LOOP -- TO END OF PAGE 1.
24700 JD=ML
24800 975 N=INP(JD)
24900 IF(N.EQ.IBLA)GO TO 236
25000 CCZZZ IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
25100 C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
25200 33611 IF(N.EQ.'(')GO TO 697
25300 IF(N.NE.')')GO TO 2361
25400 697 INP(JD)=IBLA
25500 L=JD-1
25600 5113 IF(INP(L).NE.IBLA)GO TO 2113
25700 L=L-1
25800 GO TO 5113
25900 2113 IF(N.EQ.')')GO TO 3361
26000 IF(PARENS.EQ.0)GO TO 1140
26100 LCNT=LCNT+3
26200 IF(MOT.NE.0)CALL ERR(3)
26300 MOT=LCNT-1
26400 1140 DO 11401 JC=1,LCNT-1,3
26500 IF(INP(L).NE.LIST(JC))GO TO 11401
26600 C FINDS DUPLICATE IDENTIFIER
26700 TYPE 11402,INP(L)
26800 CALL EXIT
27200
27300 11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
27400 11401 CONTINUE
27500 LIST(LCNT)=INP(L)
27600 PARENS=-1.
27700 INP(L)=IBLA
27800 LIST(LCNT+1)=I
27900 GO TO 236
28000 C ''''''' FOR SINGLE QUOTES
28100 3361 IPRN=IPRN+1
28200 GO TO 236
28300 C JUMPS BACK INTO QUOTE SECTION
28400 CQ IF(PARENS.EQ.0)GO TO 2140
28500 CQ LIST(LCNT+2)=L
28600 CQ LCNT=LCNT+3
28700 CQ PARENS=0
28800 CQ GO TO 33612
28900 CQ2140 LIST(MOT)=L
29000 CQ GO TO 33612
29100 CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
29200 C @@@@@@@@@@@@ /@Z/DS3/ ETC.
29300 2361 IF(N.NE.'@')GO TO 5361
29400 DO 113 L=1,LEND
29500 K=JD+L
29600 C K IS USED AT 240!!!
29700 JG=INP(K)
29800 IF(JG.NE.'-')GO TO 6113
29900 RETRO=0
30000 INP(K)=IBLA
30100 GO TO 113
30200 6113 IF(JG.NE.'$')GO TO 7113
30300 C '$' IS FOR INVERSIONS IN 'NOTES'
30400 INVRT=0
30500 GO TO 113
30600 7113 IF(JG.NE.IBLA)GO TO 4113
30700 113 CONTINUE
30800 4113 DO 6361 IJ=1,LCNT,3
30900 IF(JG.NE.LIST(IJ))GO TO 6361
31000 VX1=0
31100 DO 40 M=JD+2,LEND
31200 JG=INP(M)
31300 IF(JG.EQ.IBLA)GO TO 40
31400 CCZZZ IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
31500 IF(JG.EQ.KSLA)GO TO 140
31600 IF(JG.EQ.ISEMI)GO TO 140
31700 ML=M
31800 GO TO 240
31900 40 CONTINUE
32000 240 JC=JA
32100 JA=-1
32200 INP(K)=IBLA
32300 CALL SCANR
32400 JA=JC
32500 140 JC=1
32600 KN=LIST(IJ+1)
32700 M=LIST(IJ+2)+1
32800 IF(RETRO)GO TO 640
32900 JC=M-1
33000 M=KN-1
33100 KN=JC
33200 JC=-1
33300 RETRO=-1.
33400 640 IF(INVRT)GO TO 940
33500 840 X=V(KN)
33600 V(I)=X+VX1
33700 C FINDS CENTER FOR INVERSION (+TRANSP.)
33800 I=I+1
33900 KN=KN+JC
34000 IF(V(KN-JC).NE.85.)GO TO 940
34100 V(I-1)=85.
34200 GO TO 840
34300
34400 940 Z=V(KN)
34500 IF(INVRT.EQ.0)GO TO 440
34600 IF(VX1.EQ.0)GO TO 540
34700 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
34800 IF(CODE.EQ.-33.)GO TO 440
34900 V(I)=Z*VX1
35000 GO TO 7361
35100 440 IF(Z.EQ.85.)GO TO 540
35200 Y=0
35300 IF(INVRT.EQ.0)Y=(X-Z)*2.
35400 V(I)=Z+VX1+Y
35500 GO TO 7361
35600 540 V(I)=Z
35700 7361 I=I+1
35800 KN=KN+JC
35900 IF(KN.NE.M)GO TO 940
36000
36100 INVRT=-1
36200 RB=V(I-1)
36300 DO 8361 L=JD,LEND
36400 JG=INP(L)
36500 C PUT IN NOV 25, 72
36600 CCZZZ IF(JG.EQ.ISEMI)GO TO 93612
36700 KN=L
36800 INP(L)=IBLA
36900 IF(JG.EQ.KSLA)GO TO 9361
37000 IF(JG.EQ.')')IPRN=IPRN+1
37100 CCZZZ8361 IF(JG.EQ.'*')IAMP=-1
37200 8361 IF(JG.EQ.ISEMI)IAMP=-1
37250 MLX=LEND
37275 C ↑↑↑↑↑↑↑ 6/75
37300 GO TO 93612
37400 9361 MLX=L
37450 IF(L.EQ.LEND)GO TO 93612
37460 C ↑↑↑↑↑↑↑ 6/75
37500 C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
37600 IF(IAMP.NE.0)GO TO 797
37700 IF(QTS)GO TO 1773
37800 C GO BACK IF NOT END OF LINE
37900 797 JZ=-1
38000 93612 IF(IAMP.EQ.0)GO TO 93611
38100 C NOV 25, 72
38200 IF(QTS)GO TO 3013
38300 GO TO 2722
38400 C THESE ARE FOR "LIT" ITEMS
38500 C ******* DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
38600 C NO $ WITH FUNC. $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
38700 CCZZZ93611 IF(JG.EQ.ISEMI)GO TO 7773
38800 93611 IF(KN.EQ.LEND)GO TO 7773
38900 JZ=0
39000 IF(IPRN.NE.0)GO TO 1773
39100 C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
39200 GO TO 236
39300 C LAST TIME FOR QUOTES
39400
39500 C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
39600 C JUMPS TO END STRING OF QUOTES
39700 6361 CONTINUE
39800 CALL ERR(LN)
39900 C @@@@@@@@@@@@@@@@@@@@@@@@@@
40000 5361 IF(N.EQ.'$')CALL ERR(LN)
40100 C FOUND $ BUT NO @!
40200 IF(N.NE.ID)GO TO 53611
40300 IF(ISUB.NE.1)GO TO 53611
40400 IF(INP(JD+1).NE.IF)GO TO 236
40500 C JUMP IF NOT DUTY FACTOR
40600 DF=DF-100.
40700 GO TO 43615
40800 53611 IF(N.NE.ISS)GO TO 53612
40900 IF(INP(JD+1).NE.'U')GO TO 53612
41000 DF=DF-200
41100 C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
41200 GO TO 43615
41300 53612 IF(N.NE.IAA)GO TO 43611
41400 C FINDS 'ALL'.
41500 IF(INP(JD+1).NE.'L')GO TO 236
41600 ALL=-1.
41700 GO TO 43615
41800 C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
41900
42000 C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
42100 C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
42200 C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
42300 C BEFORE! QUAD (IF USED).
42400 C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
42500 C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
42600 C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
42700 43611 IF(N.NE.'Q')GO TO 4361
42800 IF(INP(JD+1).NE.'U')GO TO 4361
42900 QX=-13.
43000 DO 43612 N=JD,LEND
43100 J=INP(N)
43200 IF(J.EQ.IXX)QX=QX-1.
43300 IF(J.EQ.IF)QX=QX-2.
43400 IF(J.EQ.IBLA)GO TO 236
43500 IF(J.EQ.KSLA)GO TO 236
43600 CCZZZ IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43700 43612 INP(N)=IBLA
43800 4361 IF(N.NE.'I')GO TO 43613
43900 IF(ISUB.NE.4)GO TO 43613
44000 C 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
44100 INVIS(LK)=-1
44200 43615 DO 43614 L=JD,LEND
44300 N=INP(L)
44400 CC IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
44500 IF(N.EQ.IBLA)GO TO 236
44600 IF(N.EQ.ISEMI)GO TO 236
44700 CCZZZ IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
44800 43614 INP(L)=IBLA
44900 CC43613 IF(N.NE.KSLA)GO TO 636
45000 43613 IF(N.NE.KSLA)GO TO 1336
45100 CC JZ=-1
45200 IF(JD.GE.LEND-1)JZ=0
45300 C SO IT WILL READ NEXT LINE.
45400 CZZZZZZZZZZZZZZZ INP(JD)=ISEMI
45500 GO TO 336
45600 CCZZZ436 IF(INP(MLX).NE.IBLA)GO TO 336
45700 CCZZZ MLX=MLX+1
45800 CCZZZ GO TO 436
45900 CC636 IF(JD.LT.LEND)GO TO 1336
46000 CC ICON=0
46100 CC GO TO 77731
46200 CC GO TO 7773
46300 C TO CONTINUE ON NEXT LINE.
46400 CCZZZ636 IF(N.NE.ISEMI)GO TO 936
46500 1336 IF(N.NE.ISEMI)GO TO 936
46600 IAMP=-1
46700 CC IF(ISUB.NE.1)IAMP=-1
46800 336 MLX=JD+1
46900 IF(ISUB.EQ.104)GO TO 104
47000 IF(ISUB.GT.3)GO TO 1899
47100 GO TO (101,102,103),ISUB
47200 C PAR MOV LIST OTHERS
47300 CCZZZ936 IF(N.NE.IDOT)GO TO 736
47400 936 IF(N.NE.IDOT)GO TO 136
47500 L=INP(JD+1)
47600 DO 836 KL=1,10
47700 836 IF(L.EQ.IDAT(KL))GO TO 236
47800 IF(CODE.EQ.-22.)INP(JD)=1
47900 GO TO 236
48000 C CHANGES DOTTED RHYTHMS TO '1'S.
48100 CCZZZ736 IF(N.NE.'*')GO TO 136
48200 CCZZZ IAMP=-1
48300 CCZZZ INP(JD)=IBLA
48400 CCZZZ GO TO 336
48500 136 IF(N.NE.IQT)GO TO 236
48600 DO 1361 K=JD+1,LEND
48700 IF(INP(K).NE.IQT)GO TO 1361
48800 JD=K+1
48900 GO TO 975
49000 C SKIPS MATERIAL IN QUOTES
49100 1361 CONTINUE
49200 CALL ERR(LN)
49300 C OPEN QUOTES
49400 236 JD=JD+1
49500 IF(JD.LE.LEND)GO TO 975
49600 CALL ERR(1)
49900 1899 CALL SCANR
50000 CZZZZZZZ ML=MLX
50100 CZZZZZZZZZZZZZZZZZZZZZZZZZZ
50200 GO TO(1,2,3,4,5,6),ISUB
00100 101 N=INP(ML)
00200 IZ=ML
00300 ML=ML+1
00400 IF(N.EQ.IBLA)GO TO 101
00500 C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600 JA=-1
00700 IF(N.EQ.IPP)GO TO 1
00800 IF(N.EQ.IE)GO TO 2308
00900 IF(N.EQ.'R')CALL RUNIT
01000 C 'RUN' MAY REPLACE 'END' FOR LAST INST.
01100 IF(N.EQ.ID)GO TO 7720
01200 CALL ERR(LN)
01300 1 CALL SCANR
01400 LPAR=VX1
01500 IJ=LPAR
01600 IF(QX.GE.0)GO TO 5703
01700 IJ=LPAR+4
01800 C SETS UP PARAM FOR QUAD CALL
01900 V(I)=IJ+LK*10000
02000 V(I+1)=2*ALL
02100 C TEST "ALL" FEATURE HERE!!!!!!!
02200 C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300 V(I+2)=QX
02400 I=I+3
02500 QX=0.
02600 5703 IAMP=0
02700 IF(IJ.LE.NP(LK))GO TO 897
02800 IF(IJ.LT.31)NP(LK)=IJ
02900 897 IF(LPAR.EQ.32)LPAR=1
03000 V(I)=LPAR+LK*10000
03100 C +1=WDCNT, +2=CODE, +3='NM' CCCCC
03200 IJ=I+1
03300 I=I+4
03400 ITMP=0
03500 CODE=0
03600 NFLG=1
03700 ML=IZ+M
03800 C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
03900 C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
04000 C QU=QUADC QUX=QUADX
04100 5702 ML=ML+1
04200 CC IF(ML.GT.72)GO TO 99
04300 N=INP(ML)
04400 IF(N.EQ.IBLA)GO TO 5702
04500 IF(N.EQ.',')GO TO 5702
04600 NL=INP(ML+1)
04700 JA=-1
04800 ISUB=0
04900 IF(N.EQ.IXX)GO TO 2703
05000 IF(N.EQ.'R')GO TO 6702
05100 IF(N.EQ.IF)GO TO 8702
05110 IF(N.EQ.IPP)GO TO 7006
05115 IF(N.NE.'C')GO TO 4005
05120 IF(NL.EQ.'U')GO TO 7006
05160 C FOR 'CUTOFF'
05200 4005 JA=0
05300 IF(N.EQ.IEN)GO TO 6005
05400 IF(N.EQ.'M')GO TO 703
05500 IF(N.EQ.'L')GO TO 2720
05600 IF(N.EQ.ISS)GO TO 6703
05700 IF(N.EQ.ITT)GO TO 4018
05800 IF(N.EQ.IQT)GO TO 5720
05900 IF(N.EQ.ISEMI)GO TO 2018
06000 C 7/75 IF(N.EQ.IPP)JA=-1
06100 C FOR ;P5 P3;
06200 7006 CALL SCANR
06300 IF(ISUB.EQ.8)GO TO 8
06400 I=I+JJ
06500 V(IJ+1)=NNUM+DF
06600 IF(JJ.EQ.1)GO TO 4006
06700 C IF NNUM IS '-2' THEN NOTES ARE PRINTED
06800 IF(NNUM.NE.-2)GO TO 5006
06900 IX=IJ+3
07000 DO 2006 K=2,JJ,3
07100 2006 CALL RANR(VX,K)
07200 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
07300 5006 IX=IJ+2
07400 DO 6006 K=1,JJ
07500 6006 V(IX+K)=VX(K)
07510 IF(NL.EQ.'U')GO TO 8006
07600 V(IX+JJ-2)=1.
07700 C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
07800 GO TO 3013
07900 4006 IF(JA)VX1=VX1/100.+9999.
08000 C CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
08100 V(I-1)=VX1
08200 GO TO 3013
08210 8006 V(IJ+1)=-19
08220 C FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
08230 GO TO 3013
08300 6702 IF(NL.EQ.IE)GO TO 2703
08400 C JUMP IF "REP"
08500 IF(NL.EQ.ITT)GO TO 4018
08600 C JUMP IF "RTAP"
08700 CODE=-22
08800 IF(NL.EQ.'L')CODE=-46.0
08900 C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
09000 IF(NL.NE.IEN)GO TO 1016
09100 C JUMP IF NOT "RNOTES"
09200 JA=0
09300 C FOR SCANR
09400 CODE=-36.
09500 GO TO 1016
09600 6005 CODE=-33
09700 IF(NL.NE.'U')GO TO 1016
09800 CODE=-44.
09900 1610 JA=-1
10000 GO TO 1016
10100 8702 CODE=-35
10200 IF(NL.EQ.'U')GO TO 1016
10300 ML=ML+1
10400 CALL SCANR
10500 7 V(IJ+1)=CODE+DF
10600 V(IJ+2)=1.
10700 IF(VX1.GT.15)CALL ERR(4)
10800 C TRAPS F NUMS >15.
10900 V(I)=VX1+85.
11000 GO TO 7703
11100 C******** MOVE IS NEXT ***********
11200 703 BW=V(IJ-2)
11300 IC=0
11400 CC DO 7031 K=ML+1,72
11500 DO 7031 K=ML+1,LEND
11600 IF(INP(K).EQ.KSLA)GO TO 8031
11700 CC IF(INP(K).EQ.ISEMI)GO TO 8031
11800 7031 IF(INP(K).EQ.IXX)IC=-1
11900 C IC=-1 IS FOR MOVX
12000 8031 I=I-1
12100 V(I)=0
12200 X=-9900.-BY
12300 IF(BY.EQ.0)X=-9900.-BG(LK)
12400 IF(BW.EQ.X)GO TO 8005
12500 IF(BW.NE.-9900.-BY)GO TO 1102
12600 V(IJ-2)=X
12700 GO TO 8005
12800 1102 V(IJ)=V(IJ-1)
12900 V(IJ-1)=X
13000 IJ=IJ+1
13100 I=I+1
13200 8005 LP=IJ-1
13300 BW=-9900.-X
13400 ISUB=2
13500 IZ=-1
13600 C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13700 4703 GO TO 1299
13800 102 IF(IZ.LT.0)GO TO 2102
13900 C SKIPS NEXT FIRST TIME
14000 BW=V(ICT)+BW
14100 V(I)=-9900.-BW
14200 V(I+1)=V(LP)
14300 V(I+2)=(JJ+2)*ALL
14400 V(I+3)=CODE+DF
14500 I=I+4
14600 IZ=1
14700 2102 IF(BW.LT.10000.)CALL BGSORT(BW)
14800 C ROUND-OFF NONSENSE
14900 2 VX3=-9900.
15000 VX2=VX3
15100 CALL SCANR
15200 IF(JJ.GT.0)GO TO 5102
15300 JJ=ILIT
15400 C SLASH WILL REPEAT MOVE INPUT -- 6/74
15500 DO 6102 K=1,JJ
15600 6102 VX(K)=VX(K+20)
15700 GO TO 5005
15800 C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
15900 5102 IF(JJ.EQ.4)CALL ERR(LN)
16000 C ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
16100 IF(VX3.NE.-9900.)GO TO 3102
16200 IF(VX2.NE.-9900.)GO TO 4102
16300 VX2=VX1
16400 VX1=10000.
16500 4102 VX3=VX2
16600 JJ=3
16700 C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
16800 3102 IF(IZ.GE.0)GO TO 3006
16900 V(IJ)=(JJ+2)*ALL
17000 C WORD COUNT
17100 CODE=-55.
17200 IF(JJ.NE.3)CODE=-57.
17300 IF(NFLG)CODE=CODE-1.
17400 IF(IC)CODE=-59.
17500 C CODE=-56 OR -58 FOR NOTES.
17600 V(IJ+1)=CODE+DF
17700 IZ=0
17800 3006 IF(NFLG.EQ.1)GO TO 5005
17900 CALL RANR(VX,2)
18000 IF(JJ.NE.3)CALL RANR(VX,4)
18100 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
18200 5005 ICT=I
18300 ILIT=JJ
18400 C SAVES FOR SLASH REPEAT FEATURE
18500 IJ=IJ+1
18600 DO 1006 K=1,JJ
18700 VX(20+K)=VX(K)
18800 C SAVES FOR SLASH REPEAT FEATURE
18900 1006 V(IJ+K)=VX(K)
19000 I=I+JJ
19100 IJ=I+2
19200 IF(IAMP.EQ.0)GO TO 1299
19300 C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
19400 V(I)=-9900.-BY
19500 GO TO 8703
19600
19700 7703 V(IJ)=4.*ALL
19800 8703 I=I+1
19900 GO TO 4773
20000 C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
20100 6703 CODE=-12.
20200 IF(INP(ML+3).EQ.'L')CODE=-11.
20300 V(IJ)=2.*ALL
20400 V(IJ+1)=CODE+DF
20500 I=I-1
20600 GO TO 4773
20700 4018 CNT(LK)=-9900.-BY
20800 P(LK)=V(I-4)
20900 CC 6/74 COLGATE JREAD=3
21000 CC 6/74 COLGATE GO TO 4400
21100 1444 IF(READER(JNP))CALL RUNIT
21200 C READS A LINE. IF END OF FILE, JUMPS.
21300 443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
21400 IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
21500 C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
21600 IF(J.EQ.'CONDU')GO TO 444
21700 IF(NL.NE.ITT)GO TO 2338
21800 CODE=-23.
21900 GO TO 1016
22000 2338 I=I-4
22100 GO TO 4773
22200 3018 CNT(KZY)=-9900.
22300 GO TO 1444
22400 444 P(KZY)=980000.
22500 GO TO 2308
22600 C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22700 C 'REP'
22800 2703 ML=ML+1
22900 VX1=0
23000 VX2=0
23100 VX3=0
23200 IF(N.EQ.IXX)GO TO 2704
23300 INP(ML)=IBLA
23400 INP(ML+1)=IBLA
23500 C WIPES OUT 'EP' IN 'REP'
23600 2704 CALL SCANR
23700 V(IJ)=3.
23800 V(IJ+1)=-66.0
23900 IF(VX1.EQ.32.)VX1=1.
24000 IF(VX1.EQ.0)VX1=LPAR
24100 IF(VX2.EQ.0)VX2=LK-1
24200 V(IJ+2)=VX1+VX2*10000.
24300 KL=VX2
24400 IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24500 IF(VX3.EQ.0)GO TO 4773
24600 L=VX3
24700 ML=LK+1
24800 DO 1018 KL=ML,L
24900 IF(LPAR.LE.NP(KL))GO TO 997
25000 IF(LPAR.LT.31)NP(KL)=LPAR
25100 997 IF(DUR(KL))DUR(KL)=DUR(LK)
25200 C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
25300 V(I)=V(I-4)+10000.
25400 V(I+1)=3.
25500 V(I+2)=-66.
25600 V(I+3)=V(I-1)
25700 1018 I=I+4
25800 GO TO 4773
25900
26000 2018 IF(DF.EQ.0)GO TO 20181
26100 C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
26200 V(IJ+1)=-201.
26300 V(IJ+2)=1.
26400 V(IJ+3)=0
26500 GO TO 7703
26600 20181 V(IJ)=3.
26700 V(IJ+1)=-66.
26800 V(IJ+2)=NW+LK*10000
26900 GO TO 4773
27000 C READS /P5 .3 "ABC" .7 "XYZ"/
27100
27200 8 V(IJ+1)=-77.+DF
27300 C DF HAS SUBR CALL INFO
27400 I=I+1
27500 VX(JJ-1)=1
27600 C FOR RAND. SINGLE LITS.
27700 DO 3722 K=1,JJ,2
27800 V(I)=VX(K)
27900 3722 I=I+1
28000 V(IJ+2)=JJ/2
28100 V(IJ+3)=I
28200 DO 4722 K=2,JJ,2
28300 KN=I
28400 I=I+1
28500 L=VX(K)
28600 DO 6722 KL=L,LEND
28700 IF(INP(KL).EQ.IQT)GO TO 4722
28800 IV(I)=INP(KL)
28900 6722 I=I+1
29000 4722 V(KN)=I-KN-1
29100 V(IJ)=(I-IJ)*ALL
29200 GO TO 4773
29300 2720 QTS=0
29400 ISUB=104
29500 GO TO 1299
29600
29700 104 DO 6721 K=ML,LEND
29800 JC=K+1
29850 KL=INP(K)
29900 IF(KL.EQ.IQT)GO TO 7721
30000 IF(KL.EQ.KSLA)GO TO 7232
30100 6721 IF(KL.EQ.ISEMI)GO TO 7232
30200 C FOR REPEAT OF ITEM BY SLASH
30300 CC7232 DO 7231 K=I-1,1,-1
30400 CC CHNGD 6/74 IF(ABS(V(K)).GT.72.)GO TO 7231
30500 CC NL=V(K)
30600 CC DO 7230 KL=K,K+NL
30700 7232 DO 7230 KL=ILIT,ILIT+NLIT
30800 V(I)=V(KL)
30900 7230 I=I+1
31000 GO TO 27222
31100 7231 CONTINUE
31200
31300 5720 IAMP=-1
31400 JC=ML+1
31500 C FOR SINGLE 'LIT' ITEMS.
31600 7721 DO 1722 KL=JC+1,LEND
31700 IF(INP(KL).NE.IQT)GO TO 1722
31800 JD=KL-1
31900 ML=KL+1
32000 NLIT=KL-JC
32100 C EXTENT OF LIT ITEM IS FOUND
32200 GO TO 8721
32300 1722 CONTINUE
32400 C CAN'T USE SLASH FOR REPEAT AFTER @Q
32500 8721 V(I)=NLIT
32600 ILIT=I
32700 DO 9721 K=JC,JD
32800 C PUTS ITEM IN "IV" ARRAY
32900 I=I+1
33000 9721 IV(I)=INP(K)
33100 I=I+1
33200 27222 IF(IAMP.EQ.0)GO TO 1299
33300 2722 V(I)=999.
33400 QTS=-1.
33500 27221 V(IJ+1)=-88.+DF
33600 V(IJ)=(I-IJ+1)*ALL
33700 IJ=IJ+2
33800 V(IJ)=IJ+1
33900 I=I+1
34000 ISUB=1
34100 GO TO 1299
34200
34300 7720 V(I)=LK
34400 V(I+1)=3.
34500 V(I+2)=-67.
34600 ML=ML+4
34700 CALL SCANR
34800 V(I+3)=VX1
34900 I=I+4
35000 L=VX1
35100 IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
35200 IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
35300 GO TO 4773
35400 C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
35500 142 FORMAT(I,15A5)
35600 1301 FORMAT(15A5)
35700 CCC2773 FORMAT(I,A5,72A1)
35800 CC2114 FORMAT(I,80A1)
35900 300 FORMAT(I,3F,A1)
36000 301 FORMAT(3F,A1)
36100 6 KB=KB+1
36200 IF(JED.GT.0)JED=0
36300 IF(J.EQ.'INSER')GO TO 1340
36400 OTH(KB,1)=VX1*100000.+VX2*100.+VX3
36500 GO TO 340
36600 1340 X=VX1
36700 IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
36800 OTH(KB,1)=X
36900 GO TO 1338
37000 C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
37100 C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
37200 C - BEGIN LINE WITH <,END WITH ;
37300 C UP TO 75 CHARACTERS MAY BE TYPED.
37400 340 IF(VX3.NE.2)GO TO 1338
37500 IF(ITYP.GE.0)GO TO 449
37600 CC JREAD=5
37700 CC 6/74 COLGATE GO TO 4400
37800 IF(READER(JNP))CALL RUNIT
37900 C READS A LINE. IF END OF FILE, JUMPS.
38000 445 OTH(KB,3)=1.
38100 IF(LN.EQ.0)GO TO 447
38200 REREAD 300,K,OTH(KB,2)
38300 GO TO 1447
38400 447 REREAD 301,OTH(KB,2)
38500 1447 IF(JED)GO TO 2308
38600 3445 TYPE TEDIT
38700 ACCEPT 77732,K
38800 IF(K.EQ.IG)JED=-1
38900 IF(J.EQ.'INSER')GO TO 3446
39000 IF(K.NE.'Y')GO TO 2308
39100 IF(JED)GO TO 2308
39200 449 TYPE TPALN
39300 ACCEPT 301,OTH(KB,2)
39400 IF(JED)WRITE(21,301) OTH(KB,2)
39500 GO TO 2308
39600
39700 1338 IF(ITYP.GE.0)GO TO 1449
39800 CC JREAD=6
39900 CC 6/74 COLGATE GO TO 4400
40000 IF(READER(JNP))CALL RUNIT
40100 C READS A LINE. IF END OF FILE, JUMPS.
40200 446 IF(LN.EQ.0)GO TO 448
40300 REREAD 142,K,(OTH(KB,JD),JD=2,16)
40400 GO TO 1446
40500 448 REREAD 1301,(OTH(KB,JD),JD=2,16)
40600 1446 IF(JED)2446,3445,2446
40700 3446 IF(K.NE.'Y')GO TO 2446
40800 IF(JED)GO TO 2446
40900 1449 TYPE TPALN
41000 ACCEPT 1301,(OTH(KB,JD),JD=2,16)
41100 IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
41200 2446 X=OTH(KB,2)
41300 IF(J.NE.'INSER')GO TO 971
41400 IF(VX3.EQ.0)GO TO 971
41500 IF(X.NE.'*')GO TO 6
41600 971 IF(X.EQ.'*')KB=KB-1
41700 C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
41800 C LAST LINE HAS '*' IN COLUMN 1.
41900 GO TO 2308
42000 C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
42100 C INSERT MAY INCLUDE 10 CHARS(P3-P30),
42200 C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
42300 C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
42400 C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
42500 C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
42600 C BX=INST N. Y=NOTE N. Z=PARAM N.
00100 1106 KTMP=1
00200 TP=60.
00300 IAMP=0
00400 BW=BY
00500 ITMP=-1
00600 ISUB=5
00700 JA=-1
00800 GO TO 2016
00900 3019 V(I)=990000.00
01000 V(I+1)=4.
01100 V(I+2)=VX1
01200 V(I+3)=VX2/TP
01300 V(I+4)=VX3/TP
01400 I=I+5
01500 BY=BW
01600 C SEPT 18, 70
01700 IF(VX1.EQ.0)GO TO 2308
01800 BW=BW+VX1
01900 V(I)=-9900.-BW
02000 I=I+1
02100 CALL BGSORT(BW)
02200 9003 IF(IAMP)GO TO 4003
02300 2016 VX3=0
02400 VX2=0
02500 GO TO 1299
02600 5 IF(VX2.NE.0)GO TO 105
02700 C 'TEMPO/120;' OR 'TEMPO/1.5 72;' IS OK.
02800 VX2=VX1
02900 VX1=0
03000 105 IF(VX3.EQ.0)VX3=VX2
03100 IF(VX2.LT.11.)TP=1.
03200 IF(J.EQ.ITMPO)GO TO 3019
03300 PCH(1,KTMP)=VX1
03400 PCH(2,KTMP)=VX2
03500 PCH(3,KTMP)=VX3
03600 C PCH(1)=TIME (2)=MM1 (3)=MM2
03700 KTMP=KTMP+1
03800 IF(IAMP.EQ.0)GO TO 2016
03900 4003 VX1=0
04000 IAMP=0
04100 VX2=VX3
04200 IF(J.EQ.ITMPO)GO TO 3019
04300 PCH(1,KTMP)=0
04400 PCH(2,KTMP)=VX2
04500 PCH(3,KTMP)=VX2
04600 C MM CAN BE FROM 11 UP TEMPO FACTOR FROM 10 DOWN.
04700 C UP TO 30 TEMPO CHANGES MAY BE MADE.
04800
04900 1016 IA=I
05000 IZ=1
05100 3100 V(I-2)=CODE+DF
05200 ISUB=3
05300 5016 IF(IAMP.GE.0)GO TO 1299
05400 117 IF(IZ-2)3013,9004,9004
05500 103 K=INP(ML)
05600 IF(K.EQ.ITT)GO TO 1106
05700 IF(K.EQ.KSLA)GO TO 1014
05800 IF(K.EQ.ISEMI)GO TO 1014
05900 CZZZZZZZZZZZZ CC ZZZZZZZZZZZZ
06000 IF(K.NE.IBLA) GO TO 1899
06100 ML=ML+1
06200 GO TO 103
06300 3 IF(VX1.EQ.-99.)GO TO 4022
06400 IF(CODE.EQ.-22.)GO TO 2017
06500 IF(CODE.LT.-23)GO TO 17
06600 IF(IZ/2*2.EQ.IZ)GO TO 17
06700 C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06800 2017 IF(VX1.EQ.10000.)GO TO 17
06900 VX1=4./VX1
07000 IF(JJ.NE.1)GO TO 2014
07100 V(I)=VX1
07200 GO TO 114
07300
07400 1217 IF(VX1.EQ.10000.)GO TO 114
07500 C FOR "FINE" IN LIST
07600 V(I+1)=VX2
07700 IF(CODE.EQ.-36.)CALL RANR(V,I)
07800 2217 I=I+1
07900 C SETS UP STRING OF RAND SELECTIONS
08000 GO TO 114
08100 3217 V(I)=V(I-2)
08200 V(I+1)=RB
08300 C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
08400 GO TO 2217
08500 C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
08600
08700 2014 DO 9006 L=2,JJ
08800 IF(VX(L).EQ.0)GO TO 17
08900 9006 VX1=4./VX(L)+VX1
09000 JJ=1
09100 17 V(I)=VX1
09200 IF(CODE.EQ.-46.)GO TO 1217
09300 IF(CODE.EQ.-36.)GO TO 1217
09400 IF(CODE.NE.-35)GO TO 972
09500 IF(VX1.GT.15)CALL ERR(4)
09600 C FINDS F NUM.>15!
09700 C JUMP IF STRING OF RAND SELECS.
09800 972 IF(JJ.EQ.1)GO TO 114
09900 L=VX(JJ)-1
10000 X=V(I)
10100 NL=I+1
10200 I=L+I
10300 DO 1017 K=NL,I
10400 1017 V(K)=X
10500 C ADDS UP TOTAL OF NOTES IN SEQ.
10600 IZ=IZ+L
10700 GO TO 114
10800 1014 IF(CODE.EQ.-46.)GO TO 3217
10900 IF(CODE.EQ.-36.)GO TO 3217
11000 V(I)=RB
11100 C RB SAVES IT FOR SLASH REPEAT
11200 114 RB=V(I)
11300 I=I+1
11400 IZ=IZ+1
11500 GO TO 5016
11600 4022 JC=VX2+.3
11700 JD=VX3-.5
11800 IF(JJ.EQ.2)JD=1
11900 C********* MAY 19,71 ----MANY LINES ABOVE.
12000 IZ=IZ+JC*JD
12100 C JC=HOW MANY TIMES, JD=HOW MANY NOTES
12200 DO 1005 K=1,JD
12300 NL=I+JC-1
12400 DO 2005 L=I,NL
12500 2005 V(L)=V(L-JC)
12600 1005 I=I+JC
12700 RB=V(NL)
12800 C RB SAVES DATA FOR SLASH REPEAT FEATURE.
12900 GO TO 5016
13000
13100 9004 IF(ITMP.EQ.0)GO TO 3013
13200 IZ=IZ-1
13300 C***** JAN. 1974
13400 KA=1
13500 IC=1
13600 K=0
13700 J=1
13800 Z=0
13900 RC=0
14000 9007 Y=PCH(3,IC)/TP
14100 X=PCH(2,IC)/TP
14200 Z=PCH(1,IC)
14300 CALL SQYY(YY,X,Y,Z)
14400 XT(1)=X
14500 PR=RA
14600 C75 RD=1
14700 C75 RB=0
14800 ZZ=Z
14900 CALL ACCEL
15000 IF(K.EQ.IZ)GO TO 3013
15100 IF(RA.NE.10000.)GO TO 9007
15200 C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
15300 3013 X=I-IJ
15400 V(IJ+2)=X-3.
15500 V(IJ)=X*ALL
15600 IF(CODE.NE.-35)GO TO 4773
15700 M=IJ+3
15800 C SETS NUMBERS FOR FUNCS.
15900 DO 313 K=M,I-1
16000 313 IF(V(K).LT.85.)V(K)=V(K)+85.
16100 GO TO 4773
16200
16300 END